Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / k11rmz.mac < prev next >

Wrap

Text File | 1989-06-12 | 10.3 KB | 356 lines

.title k11rmz overlayed RMS11 code (3.43) .ident /3.43/ .psect $code ; Creation: 24-Jan-86 14:06:18 Brian Nelson ; ; Will the addition of long packet support the root is getting ; too large. ; ; Entry points: ; ; delete delete a file(s) ; rename rename a file(s) ; getmcr get mcr/ccl command line, only used ONCE ; ; ; Copyright (C) 1986 Change Software, Inc .if ndf, K11INC .ift .include /IN:K11MAC.MAC/ .endc .library /LB:[1,1]RMSMAC.MLB/ .mcall $compare,$fetch ,$parse ,$search,$set ,$store .mcall fab$b ,nam$b ,$rename,$erase ,$off ,$testb nb$nod = 400 ; Node in file or default string (FNB in NAM) .enabl gbl .psect $code ,ro,i,lcl,rel,con .psect rmssup ,rw,d,lcl,rel,con .mcall fabof$ .mcall rabof$ .mcall xabof$ fabof$ RMS$L rabof$ RMS$L xabof$ RMS$L .sbttl rename ; R E N A M E ; ; input: @r5 old filename address ; 2(r5) new filename address ; 4(r5) flag, lt 0 don't print the results else print a log ; ; output: r0 error code, zero if at least one file found ; r1 number of files renamed .sbttl the real work of rename .psect $code .enabl lsb rename::save <r2,r3,r4,r5> ; save temps please mov #rnfab1 ,r0 ; point to the old name FAB mov #rnfab2 ,r1 ; point to the new name FAB mov #rnnam1 ,r2 ; point to the old name's NAMEBLOCK mov #rnnam2 ,r3 ; point to the new name's NAMEBLOCK tst fu$def ; do we really need a default device? beq 1$ ; no $store #sydisk,DNA,r0 ; yes. Stuff the default system device $store #sylen ,DNS,r0 ; name and length to the source name and $store #sydisk,DNA,r1 ; then do the same for the new name. Put $store #sylen ,DNS,r1 ; the def device address and length in. 1$: mov r0 ,r4 ; save the FAB1 pointer now ;RBD01-- strlen #defdir ; anything in the Kermit default dir? tst r0 ; if <> then use it beq 5$ ; nothing there to use, use SY: $store #defdir ,DNA,r1 ; something was there, stuff it in $store r0 ,DNS,r1 ; and the length of the default $store #defdir ,DNA,r4 ; something was there, stuff it in $store r0 ,DNS,r4 ; and the length of the default 5$: mov r4 ,r0 ; restore FAB1 pointer now $store #lun.sr ,LCH,r0 ; stuff a logical unit number $store #lun.sr ,LCH,r1 ; stuff a logical unit number sub #100 ,sp ; allocate an ESA for old name $store sp ,ESA,r2 ; and stuff the address in $store #100,ESS,r2 ; and the length of it please sub #100 ,sp ; next is the resultant string $store sp ,RSA,r2 ; buffer for the old filename $store #100,RSS,r2 ; and the size of it please sub #100 ,sp ; the new filename buffer $store sp ,ESA,r3 ; stuff address of the buffer $store #100,ESS,r3 ; and the size of it please clr -(sp) ; a count of the files done so far mov #rnfab1 ,r1 ; point to the old name FAB mov #rnfab2 ,r2 ; point to the new name FAB strlen @r5 ; get the .asciz length of old $store @r5 ,FNA,r1 ; store the old filename address $store r0 ,FNS,r1 ; stuff the length of the old name mov #rnfab1 ,r0 ; point to the old name FAB $parse r0 ; parse the old name please $compar #0 ,STS,r0 ; did the parse work out ok ? blt 90$ ; no, exit strlen 2(r5) ; get the length of the new name $store 2(r5),FNA,r2 ; stuff the new name into FNS field $store r0 ,FNS,r2 ; and the size of it please 10$: mov #rnfab1 ,r0 ; point to the old name FAB mov #rnfab2 ,r1 ; point to the new name FAB mov #rnnam1 ,r2 ; point to the old name's NAMEBLOCK mov #rnnam2 ,r3 ; point to the new name's NAMEBLOCK $set #fb$fid,FOP,r0 ; set explicit search please $search r0 ; do a directory lookup please $compar #0 ,STS,r0 ; did the lookup work ? blt 90$ ; oops, it didn't work $fetch r4 ,RSA,r2 ; get the resultant address $store r4 ,DNA,r1 ; set this as default $fetch r4 ,RSL,r2 ; get the resultant length $store r4 ,DNS,r1 ; set the default length $rename r0,,,r1 ; rename input as output $compar #0 ,sts,r0 ; error? blt 90$ ; yes, exit please inc @sp ; no errors, count that file tst 4(r5) ; should we print the results ? bmi 10$ ; no call 200$ ; yes br 10$ ; go back for more please 90$: mov @sp ,r1 ; return # files renamed dec (sp)+ ; did we get any work done ? bge 100$ ; yes $fetch r0 ,STS,r0 ; no, get the error code cmp r0 ,#ER$NMF ; no files, was it NO MORE FILES ? bne 110$ ; no mov #ER$FNF ,r0 ; yes, change it to FILE NOT FOUND br 110$ ; and exit 100$: clr r0 ; success exit, no errors 110$: add #3*100 ,sp ; pop the buffers unsave <r5,r4,r3,r2> ; pop registers now return 200$: print #300$ movb o$rsl(r2),r0 print o$rsa(r2),r0 print #310$ movb o$esl(r3),r0 print o$esa(r3),r0 print #320$ return .save .psect $PDATA ,D .enabl lc 300$: .asciz /File / 310$: .asciz / renamed to / 320$: .byte cr,lf,0 .even .restore .dsabl lsb .sbttl delete a file(s) .enabl lsb ; input: @r5 address of filename spec ; 2(r5) if eq -1, don't print the results out ; 0, print on terminal ; >0, write to lun in 2(r5) ; ; output: r0 RMS error code ; r1 number of files renamed ; ; ; internal register usage ; ; r0 RMS error STS ; r1 pointer to the FAB for this operation ; r2 pointer to the NAM block for this operation ; r3 number of files deleted ; r5 pointer to the argument list delete::save <r2,r3,r4> ; save registers we may overwrite clr r3 ; files_deleted := 0 mov #rnfab1 ,r1 ; point to the fab we use ;RBD01-- tst fu$def ; do we need a default device name? beq 1$ ; no $store #sydisk ,DNA,r1 ; yes, please stuff the correct defs $store #sylen ,DNS,r1 ; simple 1$: strlen #defdir ; anything in the Kermit default dir? tst r0 ; if <> then use it beq 5$ ; nothing there to use, use SY: $store #defdir ,DNA,r1 ; something was there, stuff it in $store r0 ,DNS,r1 ; and the length of the default 5$: $store #lun.sr,LCH,r1 ; a channel number to use for delete $off #fb$fid,FOP,r1 ; we want an implicit $SEARCH mov #rnnam1 ,r2 ; also point to the NAME block sub #200 ,sp ; allocate result name string $store sp ,RSA,r2 ; set up the pointer to name string $store #200,RSS,r2 ; and set the size of the string sub #200 ,sp ; allocate result expanded name string $store sp ,ESA,r2 ; set up the pointer to expanded name $store #200,ESS,r2 ; and set the size of the string $store #ER$FNM ,STS,r1 ; preset a bad filename error strlen @r5 ; get the length of the filename tst r0 ; anything left at all ? beq 90$ ; no, fake a bad filename please $store r0 ,FNS,r1 ; stuff the filename size in please $store @r5 ,FNA,r1 ; stuff the filename address into FAB $parse r1 ; try to parse the filename now $compar #0 ,STS,r1 ; did the parse of the name work ? blt 90$ ; no, exit and return STS in r0 10$: $erase r1 ; parse worked, try to delete it $compar #0 ,STS,r1 ; did the erase work out ok ? blt 90$ ; no inc r3 ; count the file as being deleted call 200$ ; do any echoing now please br 10$ ; next please 90$: $fetch r0 ,STS,r1 ; get the error code out please mov r3 ,r1 ; return the # of files deleted cmp r0 ,#ER$NMF ; error is no more files ? bne 95$ ; no mov #ER$FNF ,r0 ; yes, make it into file not found tst r3 ; ever delete any files at all ? beq 100$ ; no, leave the error as FNF clr r0 ; yes, at least one file deleted br 100$ ; bye 95$: tst r0 ; error code > 0 bmi 100$ ; no clr r0 ; yes, make the error STS zero then 100$: add #200*2 ,sp ; pop local buffers please unsave <r4,r3,r2> ; pop temps and exit return .sbttl printing routines for DELETE 180$: tst 2(r5) ; print out an initial header beq 190$ ; yes, but to the terminal bmi 195$ ; not at all, please strlen #300$ ; no, put it out to disk please calls putrec ,<#300$,r0,2(r5)>; dump the record to disk br 195$ ; and exit 190$: print #300$ ; dump the header to the terminal 195$: return ; bye 200$: cmp r3 ,#1 ; deleted anything as of yet ? bne 210$ ; yes call 180$ ; no, dump a header out please 210$: clr r0 ; get set to get the string length bisb o$rsl(r2),r0 ; get the string length beq 250$ ; nothing was there to print ????? tst 2(r5) ; echo files deleted to terminal ? beq 240$ ; yes, echo to tt: bmi 250$ ; no, don't echo at all calls putrec ,<o$rsa(r2),r0,2(r5)>; echo to a file that's open br 250$ 240$: print o$rsa(r2),r0 ; print the filename out to tt: print #310$ 250$: return .save .psect $PDATA ,D 300$: .asciz <cr><lf>/Files deleted:/<cr><lf> 310$: .byte cr,lf,0 .even .restore .dsabl lsb .sbttl get mcr/ccl (rsts) command line and remove task name .mcall gmcr$ ,dir$ .psect mcrbuf ,rw,d,lcl,rel,con gmcr: gmcr$ .psect $code ; G M C R ; ; output: @r5 the command line less the task name, .asciz ; r0 the length of whats left ; NOTE: blank insertion ----+ +SSH ; V +SSH ; @takefil will parse to @ takefile... +SSH ; which allows KER @TAKEFIL to work. +SSH getmcr::save <r1,r2,r3> ; just for kicks, save these /SSH clr r3 ; clear the "space flag" +SSH mov @r5 ,r2 ; point to the resultant command clrb @r2 ; insure .asciz dir$ #gmcr ; get the command line movb @#$dsw ,r0 ; get the length of it ble 90$ ; nothing mov #gmcr+g.mcrb,r1 10$: cmpb @r1 ,#40 ; look for the space delimiting beq 20$ ; the task name from the command inc r1 ; line. did not find it, keep looking sob r0 ,10$ ; keep trying br 90$ ; nothing 20$: inc r1 ; found the space, skip past it dec r0 ; whats left of it ble 90$ ; nothing clr -(sp) ; a length counter today 30$: tst r3 ; is the space flag set ? +SSH bne 32$ ; yes, go check for " " char +SSH cmpb (r1),#'@ ; no, check for "@" char +SSH bne 33$ ; no @ char, just continue +SSH inc r3 ; yes an @, so set space flag +SSH br 33$ ; and continue with copy +SSH 32$: clr r3 ; clear the space flag +SSH cmpb (r1),#40 ; char after @ is a space ? +SSH beq 33$ ; yes, continue with copy +SSH movb #40 ,(r2)+ ; no, insert a space char +SSH inc @sp ; increment count +SSH 33$: movb (r1)+ ,(r2)+ ; copy next char to buffer inc @sp ; length := succ( length ) sob r0 ,30$ ; next byte please mov (sp)+ ,r0 ; return the command length mov @r5 ,r2 ; restore pointer to the returned string calls cvt$$ ,<r2,r0,#50> ; remove leading spaces, upper case it add r0 ,r2 ; insure .asciz clrb @r2 ; simple br 100$ ; bye 90$: clr r0 ; nothing 100$: unsave <r3,r2,r1> ; pop used registers and exit return .end